home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol037 / bmenud.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  3.8 KB  |  105 lines
  1. 10 '
  2. 20 ' DO NOT RENUM OR RENAME OR COMPILE THIS PROGRAM.
  3. 30 '
  4. 40 ' BASIC MENU PROGRAM. VERSION 1.0
  5. 50 ' A MAXIMUM OF 112 BASIC FILES WILL BE HANDLED BY THIS PROGRAM.
  6. 60 ' SEE BMENU.DOC FOR MORE INFORMATION. BOB STEPHENS  SAN JOSE 12/1/82
  7. 70 DEFINT A-Z
  8. 80 DIM ARRAY$(113)
  9. 90 SCREEN 0:KEY OFF :KEY 10,"RUN"+CHR$(34)+"BMENUD"+CHR$(13)
  10. 110 ' THE FOLLOWING STATEMENTS WILL BE MODIFIED WITH OPTION 99
  11. 500 'BEGIN
  12. 510 CLS:COLOR 0,7: PRINT "         PROGRAM INFORMATION         ":COLOR 7,0
  13. 520 PRINT "This program provides a sorted menu"
  14. 530 PRINT "display of the BASIC programs on your"
  15. 540 PRINT "diskette and allows for menu selected"
  16. 550 PRINT "execution of the BASIC programs."
  17. 560 PRINT " "
  18. 570 PRINT "Option 99 is used whenever BASIC"
  19. 580 PRINT "programs are added or deleted from the"
  20. 590 PRINT "diskette. While option 99 is slow to"
  21. 600 PRINT "execute the result will be a high"
  22. 610 PRINT "performance (for BASIC) menu program."
  23. 620 PRINT "Option 99 will create and kill file"
  24. 630 PRINT "BMENU.TMP and will modify itself."
  25. 640 PRINT "Be sure the default drive (set by DOS)"
  26. 650 PRINT "is the same as the drive containing"
  27. 660 PRINT "the menu program."
  28. 670 PRINT
  29. 680 COLOR 0,7:PRINT "Do not renum or change the name of this"
  30. 690 PRINT "program. This message will self        "
  31. 700 PRINT "destruct (forever) when you ENTER.     ":COLOR 7,0:PRINT
  32. 710 PRINT "          BOB STEPHENS SAN JOSE 12/1/82"
  33. 720 PRINT
  34. 730 INPUT "Press ENTER to continue...",A$
  35. 740 GOTO 1190
  36. 999 ' END
  37. 1000 ' END OF MODIFIED AREA
  38. 1005 CLS:IF ARRAY$(64)="" THEN WIDTH 40 ELSE WIDTH 80
  39. 1010 P=0:I=0:CLS:LOCATE 1,4:COLOR 14,0
  40. 1020 PRINT "BASIC programs on this diskette:"
  41. 1030 FOR DC=1 TO 66 STEP 13
  42. 1040  FOR DR=3 TO 23
  43. 1050   I=I+1
  44. 1060   IF ARRAY$(I)="" THEN 1110 ELSE LOCATE DR,DC
  45. 1070   COLOR 0,7:PRINT USING "###";I;
  46. 1080   COLOR 7,0:PRINT " ";ARRAY$(I)
  47. 1090  NEXT DR
  48. 1100 NEXT DC
  49. 1110 LOCATE 24,1:PRINT "Enter 99 to update menu";
  50. 1120 LOCATE 25,1:INPUT "Enter number of program desired: ",P
  51. 1130 IF P < 1 OR P >= I THEN 1170
  52. 1140 WIDTH 80:CLS:PRINT "Press F10 to return to menu when finished"
  53. 1150 PRINT "or enter RUN";:PRINT CHR$(34);:PRINT "BMENUD if F10 is changed."
  54. 1160 RUN ARRAY$(P)
  55. 1170 IF P=99 THEN 1190 ELSE 110
  56. 1180 ' MENU UPDATE AREA
  57. 1190 WIDTH 80:ON ERROR GOTO 1640
  58. 1200 KILL "BMENU.TMP"
  59. 1210 ON ERROR GOTO 0
  60. 1220 CLS
  61. 1230 FILES "*.BAS":AR=0
  62. 1240 PRINT:PRINT:PRINT "Reading files":PRINT
  63. 1250 FOR I=1 TO 113
  64. 1260  ARRAY$(I)=""
  65. 1270 NEXT I
  66. 1280 FOR DR=1 TO 24
  67. 1290  FOR DC=0 TO 65 STEP 13
  68. 1300   IF CHR$(SCREEN(DR,DC+1)) = " " THEN 1380
  69. 1310   AR=AR+1:IF AR=113 THEN PRINT "To many files":END
  70. 1320   FOR L=1 TO 8
  71. 1330    ARRAY$(AR)=ARRAY$(AR)+CHR$(SCREEN(DR,DC+L))
  72. 1340   NEXT L
  73. 1350  NEXT DC
  74. 1360 NEXT DR
  75. 1370 ' SORT
  76. 1380 CKSW=1
  77. 1390 PRINT "Sorting in BMENU.TMP";
  78. 1400 WHILE CKSW=1:CKSW=0
  79. 1410  FOR I=2 TO AR
  80. 1420   IF ARRAY$(I-1)>ARRAY$(I) THEN CKSW=1:SWAP ARRAY$(I-1),ARRAY$(I)
  81. 1430  NEXT I
  82. 1440 WEND
  83. 1450 ON ERROR GOTO 1600
  84. 1460 OPEN "BMENU.TMP" FOR OUTPUT AS #1
  85. 1470 ON ERROR GOTO 0
  86. 1480 PRINT #1,"500 'BEGIN"
  87. 1490 FOR I=1 TO AR
  88. 1500  IF ARRAY$(I)="" THEN 1530
  89. 1510  PRINT #1,STR$(I+500) + " ARRAY$(" + STR$(I) + " )=" + CHR$(34) + ARRAY$(I) + CHR$(34)
  90. 1520 NEXT I
  91. 1530 PRINT #1,"999 'END"
  92. 1540 ON ERROR GOTO 1650
  93. 1550 CLOSE
  94. 1560 CHAIN MERGE "BMENU.TMP",1570,ALL,DELETE 500-999
  95. 1570 KILL "BMENU.TMP"
  96. 1580 SAVE "BMENUD
  97. 1590 GOTO 90
  98. 1600 IF (ERR=70) AND (ERL=1460) THEN RESUME 1610 ELSE ON ERROR GOTO 0
  99. 1610 CLS:PRINT "The disk is write protected!"
  100. 1620 PRINT "Remove tab and press F10 or abort the program.":PRINT
  101. 1630 KEY ON:END
  102. 1640 IF (ERR=53) AND (ERL=1200) THEN RESUME NEXT ELSE ON ERROR GOTO 0
  103. 1650 IF (ERR=5) AND (ERL=1560) THEN RESUME 1660 ELSE ON ERROR GOTO 0
  104. 1660 ON ERROR GOTO 0:CHAIN MERGE "BMENU.TMP",1570,ALL:GOTO 1570
  105. (ERR=5) AND (